perm filename PARE.SAI[X,ALS]1 blob
sn#078549 filedate 1973-12-23 generic text, type T, neo UTF8
00010 BEGIN "FIX"
00020 DEFINE ⊂="COMMENT"; ⊂ NOV.26,1973;
00060 DEFINE ⊃="⊂";
00070 DEFINE CR="'15",LF="'12",CRLF="CR&LF",TB="'11";
00090 LABEL STARTP,STOPP,TOFORM;
00100 DEFINE \=" "; ⊂ DEFINE \="SAFE"; ⊂ Alternarte definitions;
00120 require "INDATE[X,ALS]" LOAD_MODULE;
00220 EXTERNAL PROCEDURE PREPARE;
00230 EXTERNAL PROCEDURE DEFINES;
00240 EXTERNAL INTEGER ARRAY INNAME,INDATA[0:32];
00250 EXTERNAL PROCEDURE DATOUT;
00260 EXTERNAL INTEGER INFLAG,NX;
00270 \ INTERNAL REAL ARRAY C[0:512];
00320 \ INTEGER ARRAY LFILE[0:'177];
00350 \ INTERNAL INTEGER ARRAY FVAL[0:8];
00375 \ INTEGER ARRAY FFTB[0:511]; INTEGER FFTX;
00380 INTEGER FX;
00400 INTEGER I,J,K,L,PP,CHAN2,EOF,POINTF;
00420 INTERNAL INTEGER M,N;
00440 INTEGER JP;
00470 BOOLEAN ER;
00490 INTERNAL INTEGER CHAN5;
00510 STRING FILEN,FILEF,READ,READ1,READT,
00515 READTT,FILEO,READ2,FILEQ,TFILE,FILLST,FILEP;
00520
00600
02490
02500 PROCEDURE FFTIN;
02510 BEGIN
02520 INTEGER I,J;
02530
02540 IF FFTX≥512 THEN BEGIN
02560 FFTX←0; FOR I←0 STEP 1 UNTIL 511 DO FFTB[I]←0;
02565 IF EOF=0 THEN ARRYIN(CHAN2,FFTB[0],512);
02567 IF EOF=0 THEN OUTSTR("DATA BEING READ"&CRLF) ELSE OUTSTR("EOF"&CRLF);
02570 END;
02580
02590 FVAL[4]←FFTB[FFTX];
02600 POINTF←POINT(9,FFTB[FFTX+1],-1);
02610 FOR I←0 STEP 1 UNTIL 251 DO BEGIN
02630 C[I]←ILDB(POINTF);
02635 C[I]←C[I]/4;
02640 END;
02650 FFTX←FFTX+64;
02660
02670 END;
00010
00020 FILEO←"SEG1.FFT[SYN,ALS]";
00030 INFLAG←0; PREPARE; INFLAG←1; DEFINES; ⊂ Get names and limits;
00040 STDBRK(1);
00090
00100 CHAN2←2;CHAN5←5;
00370
00380 STARTP:
00390
00400 OUTSTR(CRLF&"Type number of file to start (CR only for 1) ");
00410 IF (READ←INCHWL)="" THEN PP←1 ELSE PP←CVD(READ);
00420
00430 ⊂ Begin FILEREAD;
00440 FOR PP←PP STEP 1 UNTIL 26 DO BEGIN "FILEREAD"
00460 SETFORMAT(1,0); FILEQ←CVS(PP);
00620
00630 READT←FILEO[1 TO 3]&FILEQ&".FFT[SYN,ALS]";
00640 CLOSE(CHAN2); OPEN(CHAN2,"DSK",'10,10,0,0,0,EOF);
00650 LOOKUP(CHAN2,READT,ER); TFILE←READT;
00660 WHILE ER DO BEGIN
00670 IF PP>1 THEN BEGIN OUTSTR("Out of data, will start over."&CRLF);
00680 GOTO STARTP; END;
00690 OUTSTR(CRLF&"Can not find file "&TFILE&" File= ");
00700 LOOKUP(CHAN2,TFILE←INCHWL,ER); END;
00710 ARRYIN(CHAN2,LFILE[0],'200); ⊂ Input header;
00720 JP←10000;
00780
00790 FILEP←FILEO[1 TO 3]&FILEQ&".SYN[SYN,ALS]";
00800 CLOSE(CHAN5); OPEN(CHAN5,"DSK",'14,0,2,0,0,0);
00810 ENTER(CHAN5,FILEP,0);
00820 OUTSTR("File "&FILEP&" has been opened");
00830 ARRYOUT(CHAN5,LFILE[0],'200); ⊂ Write header;
00840 OUTSTR(" and header information written."&CRLF);
00850
00857 FFTX←512;
01030
01040 ⊂ Begin "GET";
01050
01060 WHILE TRUE DO BEGIN "GET"
01070
01625 FFTIN;
01627 IF FFTB[0]=0 THEN DONE "GET";
01630 PREPARE;
01640
01650 JP←JP-1; READ1←INCHRS;
01660 IF (READ1="F")∨(READ1="f") THEN BEGIN CLRBUF; READ1←"";
01670 JP←-10; OUTSTR(CRLF&LF&"Will stop at the end of this file"&CRLF&LF); END;
01680 IF (READ1="E")∨(READ1="e") then goto stopp;
02170
02180
02190 END "GET";
02210
02215 DATOUT;
02220 CLOSE(CHAN2); CLOSE(CHAN5);
02230 IF JP<0 THEN DONE;
02240 END "FILEREAD";
02250
02260 OUTSTR("Data are exhausted"&CRLF&LF);
02270 STOPP:
02280 CLOSE(CHAN5);CLOSE(CHAN2);
02290
02300 END "FIX";
02310